home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Mathematics / Notebooks / OperationsResearch / hungarian.m < prev    next >
Encoding:
Text File  |  1991-11-11  |  4.3 KB  |  94 lines
  1. Initialization/: 
  2.   Initialization := 
  3.    Block[{}, k =. ; v =. ; g =. ; h =. ; i = 1; j = 1; 
  4.      Clear[cost, rowMin, rowRed, colMin, colRed, rowCheck, colCheck]; 
  5.      Print[INITIALIZATION, " ", DONE]]
  6.  
  7. InputPhase/: InputPhase := 
  8.    Block[{}, n = Input["What is the square matrix order?"]; 
  9.      Do[cost[xx, yy] = 
  10.        Input["Enter row by row,one                                           \
  11.             element at a time"], {xx, n}, {yy, n}]; 
  12.      costMatrix = Table[cost[y, z], {y, n}, {z, n}]; 
  13.      Print[TableForm[costMatrix]]]
  14.  
  15. RowReduction/: RowReduction := 
  16.    Block[{}, Clear[rowMin, rowRed]; 
  17.      Do[rowMin[k] = Min[costMatrix[[k]]], {k, 1, n}]; 
  18.      Do[rowRed[k] = costMatrix[[k]] - rowMin[k], {k, 1, n}]; 
  19.      rowReducedMatrix = Table[rowRed[k], {k, n}]; 
  20.      Print[TableForm[rowReducedMatrix]]]
  21.  
  22. ColumnReduction/: 
  23.   ColumnReduction := 
  24.    Block[{}, Clear[colMin, colRed]; p = Transpose[rowReducedMatrix]; 
  25.      Do[colMin[k] = Min[p[[k]]], {k, 1, n}]; 
  26.      Do[colRed[k] = p[[k]] - colMin[k], {k, 1, n}]; 
  27.      q = Table[colRed[k], {k, n}]; colReducedMatrix = Transpose[q]; 
  28.      Print[TableForm[colReducedMatrix]]]
  29.  
  30. ZeroCheck/: ZeroCheck := 
  31.    Block[{}, Clear[rowCheck, colCheck]; v =. ; k =. ; g =. ; h =. ; i = 1; 
  32.      j = 1; Do[If[colReducedMatrix[[k,v]] == 0, 
  33.        rowCheck[i] = k; colCheck[j] = v; Print[k, v]; i++; j++], {k, n}, 
  34.       {v, n}]; zeroRows = Table[rowCheck[g], {g, 1, i - 1}]; 
  35.      zeroCols = Table[colCheck[h], {h, i - 1}]; Null]
  36.  
  37. Branching/: Branching := 
  38.    If[Length[zeroRows] >= n, Print[POSSIBLE, " ", OPTIMUM, " ", goto, " ", 
  39.      OPTIMAL, " ", function], Print[NOT, " ", OPTIMUM, " ", YET, " ", goto, 
  40.      " ", NONOPTIMAL, " ", function]]
  41.  
  42. Assignment/: Assignment := 
  43.    Block[{l1, l2, s, x = {}, y = {}}, 
  44.     If[loop != 0, t = Append[t, e[[loop]]]; u = Append[u, f[[loop]]]; 
  45.        l1 = Length[e]; x = {}; y = {}; x = e; y = f; 
  46.        Do[If[First[x] == Last[t], 
  47.          e = Drop[e, {1, 1}]; x = RotateLeft[x]; f = Drop[f, {1, 1}]; 
  48.           y = RotateLeft[y], x = RotateLeft[x]; y = RotateLeft[y]; 
  49.           e = RotateLeft[e]; f = RotateLeft[f]], {s, l1}]; x = {}; y = {}; 
  50.        x = e; y = f; l2 = Length[e]; 
  51.        Do[If[First[y] == Last[u], 
  52.          f = Drop[f, {1, 1}]; y = RotateLeft[y]; e = Drop[e, {1, 1}]; 
  53.           x = RotateLeft[x], y = RotateLeft[y]; x = RotateLeft[x]; 
  54.           f = RotateLeft[f]; e = RotateLeft[e]], {s, l2}]]; 
  55.      If[Length[e] == 0, loop = 0, loop = 1]]
  56.  
  57. Optimal/: Optimal := 
  58.    Block[{solution, l, r}, l = Length[zeroRows]; objective = 0; 
  59.      For[i = 1, i <= l, i++, t = {}; u = {}; tu = {}; e = {}; f = {}; 
  60.        e = zeroRows; f = zeroCols; loop = i; Do[Assignment, {solution, n}]; 
  61.        tu = Intersection[t, u]; 
  62.        If[Length[tu] == n, Print[OPTIMAL]; 
  63.          Do[Print[t[[r]], u[[r]]]; objective += costMatrix[[t[[r]],u[[r]]]], 
  64.           {r, n}]; Print[OBJECTIVE, " ", COST, " ", IS, " ", objective]; 
  65.          Break[]]]; If[i == l + 1, 
  66.       Print[NONOPTIMAL, " ", still, " ", go, " ", to, " ", Nonoptimal]]]
  67.  
  68. NonOptimal/: NonOptimal := 
  69.    Block[{z, rows = {}, cols = {}, uncovered = {}, common = {}, iteru, iterc, 
  70.      q2 = {}}, z = n; q2 = colReducedMatrix; timen = 1; timen++; 
  71.      While[z != 0, For[row = 1, row <= n, row++, 
  72.         If[FreeQ[rows, row], If[Count[q2[[row]], 0] == z, 
  73.           rows = Append[rows, row]; q2[[row]] = q2[[row]] + 1]]]; 
  74.        q2 = Transpose[q2]; For[col = 1, col <= n, col++, 
  75.         If[FreeQ[cols, col], If[Count[q2[[col]], 0] == z, 
  76.           cols = Append[cols, col]; q2[[col]] = q2[[col]] + 1]]]; 
  77.        q2 = Transpose[q2]; z--]; 
  78.      For[row = 1, row <= n, row++, 
  79.       For[col = 1, col <= n, col++, 
  80.        If[FreeQ[rows, row] && FreeQ[cols, col], 
  81.          uncovered = Append[uncovered, colReducedMatrix[[row,col]]]]; 
  82.         If[MemberQ[rows, row] && MemberQ[cols, col], 
  83.          common = Append[common, colReducedMatrix[[row,col]]]]]]; 
  84.      minuncov = Min[uncovered]; iteru = 1; iterc = 1; 
  85.      For[row = 1, row <= n, row++, 
  86.       For[col = 1, col <= n, col++, 
  87.        If[FreeQ[rows, row] && FreeQ[cols, col] && iteru <= Length[uncovered], 
  88.          colReducedMatrix[[row,col]] = uncovered[[iteru]] - minuncov; iteru++]
  89.          ; If[MemberQ[rows, row] && MemberQ[cols, col] && 
  90.           iterc <= Length[common], 
  91.          colReducedMatrix[[row,col]] = common[[iterc]] + minuncov; iterc++]]]\
  92.       ; TableForm[colReducedMatrix]]
  93.  
  94.